home *** CD-ROM | disk | FTP | other *** search
Text File | 1998-10-26 | 6.6 KB | 204 lines | [TEXT/ScoM] |
- ; gen-expansion and harmonizer demo
- ; by Peter Stone
- ; to analyze the score double-click high-lighted keywords
-
- (def-orchestra 'orchestra
- instruments (lefthand righthand 3rd-voice)
- )
-
- (def-grammar 'structure
- sections (intro prelude fugue)
- )
-
- (setq melody-1 (symbol-fold 12 0
- (gen-expansion 1
- (change-to-symbols '(0 0 0 0 0 0 5 5 4 4 4))
- (gen-repeat 2 '(h c b c a c b c)))))
- (setq melody-2 (symbol-fold 12 0
- (gen-expansion 1
- (change-to-symbols '(0 0 0 0 0 0 5 5 4 2 4))
- (gen-repeat 2 '(a e d e c e d e)))))
-
- (def-section intro
- default
- zone '(1/1 1/1 1/1 1/1 1/1 1/1 1/1 1/1
- 1/1 1/1 1/1 1/1 1/1 1/1 1/1 1/1
- 1/1 1/1 1/1 1/1 1/1 1/1 1/1 1/1)
- tempo-zones (same-as zone of default)
- tempo '(98)
- length '(1/16)
- velocity '(64)
- righthand
- tonality (symbol-repeat 2 (activate-tonality (melodic-minor c 5) (major d 5) (melodic-minor g 5)))
- symbol melody-1
- channel 1
- program (gm-sound-set pizzicato-strings)
- lefthand
- tonality (symbol-repeat 2 (activate-tonality (melodic-minor c 4) (major d 4) (melodic-minor g 4)))
- symbol melody-2
- channel 2
- program (gm-sound-set pizzicato-strings)
- 3rd-voice
- tonality (activate-tonality (melodic-minor c 5))
- channel 5
- program (gm-sound-set acoustic-grand-piano)
- length '(1/16)
- symbol '(=)
- velocity '(0)
- )
-
- ;;; part b
-
- (setq theme
- (gen-expansion 1
- (change-to-symbols '(0 0 0 0 0 0 5 5 4 4 4))
- '(h c b c a c b c)))
-
- (setq melody-1-source
- (append theme
- (symbol-transpose 8
- (symbol-inversion 'a theme))))
-
- (setq melody-2-source
- (symbol-transpose 11
- (symbol-shift 32
- (append theme
- (symbol-transpose 8
- (symbol-inversion 'a theme))))))
-
- (setq harmonized-melodies
- (filter-harmonize2 melody-1-source melody-2-source 12
- (activate-tonality (harmonic-minor g 3))
- '((4 4))
- '((1 2 6 8 10 11))))
-
- (setq melody-1-mat (symbol-fold 21 0 (filter-deactivate 8 30 (find-change (car harmonized-melodies)))))
- (setq melody-2-mat (symbol-fold 21 0 (filter-deactivate 8 30 (find-change (cadr harmonized-melodies)))))
-
- (setq melody-1 melody-1-mat)
-
- (setq melody-2
- (symbol-remove
- (find-common melody-1-mat melody-2-mat)
- melody-2-mat))
-
- (setq tempo-zone-len (/ (get-ratio '12/1 :ratio)
- (get-ratio '1/8 :ratio)))
-
- (def-section prelude
- default
- zone '(12/1)
- tempo-zones (symbol-trim tempo-zone-len '(1/8))
- tempo (vector-to-list (vector-round 65 90 (gen-fourier
- '(1 2 5 7) ; frequencies
- '(0.6 0.2 (gen-sin 10 0.22 64) 0.2) ; amplitudes
- '(0 45 90) ; initial phases
- tempo-zone-len)))
- tonality (activate-tonality (harmonic-minor g 3))
- lefthand
- channel 3
- program (gm-sound-set acoustic-grand-piano)
- symbol (symbol-melodize-skip melody-1)
- length (get-timing '1/16 melody-1)
- velocity (symbol-to-velocity 65 110 3 (symbol-repeat 4 theme))
- righthand
- channel 4
- program (gm-sound-set acoustic-grand-piano)
- symbol (symbol-shift 1 (symbol-melodize-skip melody-2))
- length (get-timing '1/16 melody-2)
- velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
- 3rd-voice
- channel 5
- program (gm-sound-set acoustic-grand-piano)
- length '(1/16)
- symbol '(=)
- velocity '(0)
- )
-
- ;;; fugue
-
- (setq theme-source
- (gen-random-variate 0.81 0.5 1 1 '(a e d e c e d e a b c d b d c b h c b c a c b c d e d b c b a -b)))
-
- (setq theme theme-source)
-
- (setq theme-enhansion
- (gen-expansion 1 '(a d c -c b)
- (symbol-retrograde
- (gen-loop '((8 1 1 4) (2 1 1 2))
- theme))))
-
- (init-rnd 0.453)
- (init-soup 'bach-soup theme-enhansion)
-
- (setq variations
- (symbol-trim (* (length theme) 6)
- (gen-catalyze 'bach-soup 0.1521412123425 30)))
-
- (setq melody-1-source
- (append theme
- (symbol-transpose 8
- (symbol-inversion 'a theme))
- variations))
-
- (setq melody-2-source
- (symbol-transpose -3
- (symbol-shift (* 32 1 2)
- (append theme
- (symbol-transpose 8
- (symbol-inversion 'a theme))
- variations))))
-
- (setq melody-3-source
- (symbol-transpose -5
- (symbol-shift (* 32 2 2)
- (append theme
- (symbol-transpose 8
- (symbol-inversion 'a theme))
- variations))))
-
- (setq harmonized-melodies
- (filter-harmonize3
- melody-1-source melody-2-source melody-3-source 12
- (activate-tonality (harmonic-minor g 3))
- '((64 3) (32 3))
- '((1 2 6 8 10 11))
- '(0 5 7)))
-
- (setq melody-1 (symbol-fold 14 0 (filter-deactivate 16 69 (find-change (car harmonized-melodies)))))
- (setq melody-2 (symbol-fold 21 0 (filter-deactivate 16 69 (find-change (cadr harmonized-melodies)))))
- (setq melody-3 (symbol-fold 14 0 (filter-deactivate 16 69 (find-change (caddr harmonized-melodies)))))
-
- (def-section fugue
- default
- zone '(16/1)
- tempo-zones (same-as zone of default)
- tempo '(79)
- tonality (activate-tonality (harmonic-minor g 3))
- lefthand
- channel 1
- program (gm-sound-set synth-bass-2)
- length (get-timing '1/16 melody-1)
- symbol (symbol-melodize-skip melody-1)
- velocity (symbol-to-velocity 65 110 3 (symbol-repeat 4 theme))
- righthand
- channel 4
- program (gm-sound-set fx-1-rain)
- length (get-timing '1/16 melody-2)
- symbol (symbol-shift 1 (symbol-melodize-skip melody-2))
- velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
- 3rd-voice
- channel 5
- tonality (activate-tonality (harmonic-minor g 5))
- program (gm-sound-set lead-1-square)
- length (get-timing '1/16 melody-3)
- symbol (symbol-shift 1 (symbol-melodize-skip melody-3))
- velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
- )
-
- (midiport :printer)
-
- (play-file-p "prelude midi"
- instruments '(sections)
- )
-